Scedastic Surrogate Swarm R Package - Fitting Neural Network

rm(list=ls())
library(ScedasticSurrogateSwarmR)
#set.seed(128)

Problem Setup

The scedastic surrogate swarm optimizer can be used for large dimensional problems. For example let us establish a neural network with a single hidden layer as our model function.

model_function <-function(params,ls){
  parammat <- matrix(params,nrow=3)
  l1_w <- parammat[1,]
  l1_b <- parammat[2,]
  lo_2 <- parammat[3,]

  modval<-t(pmax((l1_w%*%t(xdat))+l1_b,((l1_w%*%t(xdat))+l1_b)*0.03))%*%t(t(lo_2))
  return(modval)
}

#Equality Constraints
eq <- function(params){
  constraints = c(
  )
  return(constraints)
}

#Inequality Constraints
# of form <= 0
ineq <- function(params){
  constraints = c(
  )
  return(constraints)
}

We can set up our input values in the following manner:

ls = 20 #Layer size
ndat=50
xdat=sort(runif(ndat,-10,10))
ydat = c(sin(0.5*xdat)/2)+0.6

lowlim=rep(-1,3*ls)
highlim=rep(1,3*ls)

Swarm Optimization

Using a Scedastic Surrogate Swarm optimization:

swarm_state <- initialize_swarm(desired_values = ydat,param_len = 3*ls,lowlim=lowlim,highlim=highlim,ineq_w = c(),eq_w = c(),config = swarm.config(swarm_size = ls*2))

for (itt in 1:50){
  tempcontrol = swarm.control(poly_w=0.2,stoch_w = 0.01)
  swarm_state <- step_swarm(desired_values = ydat,swarm_state,ineq_w = c(),eq_w=c(),config = swarm.config(swarm_size=dim(swarm_state$x.p)[1],num_cluster=1,swarm.control = tempcontrol))
  matplot(xdat,swarm_state$pout,type="l",col="grey",xlab = NULL,ylab="value",ylim = c(0,1.2))
  points(xdat,ydat)
  surrogate_out <- surrogate_model(as.vector(swarm_state$poly_rec),swarm_state$polyouts,swarm_state$centersaves,deg=1)
  lines(xdat,surrogate_out,col="blue")
  lines(xdat,model_function(as.vector(swarm_state$poly_rec)),col="red")
  title("Scedastic Surrogate Swarm Optimization")
  legend(par('usr')[2], par('usr')[4], bty='n',
         xpd=NA,c("Observed","Modeled","Predicted","Actual"),fill=c("black","grey","blue","red"))
}

print(paste("Number of function evals: ",dim(swarm_state$allxp)[1]))
#> [1] "Number of function evals:  2000"

Search Optimization

We can also use the Scedastic Surrogate Swarm package to do non-swarm searching using surrogates:

search_state <- initialize_search(param_len = 3*ls,lowlim=lowlim,highlim=highlim,config = search.config(deg=1))

genstate = F
for (itt in 1:7){
  tempconfig = search.config(gen = genstate,deg=1,search_samples = ls*3*2,search_mag=0.1,revert_best = T)
  search_state <- step_search(desired_values = ydat,search_state,ineq_w = c(),eq_w=c(),config = tempconfig)

  modout = model_function(as.vector(search_state$poly_recs[1,]))
  surrogate_out <- surrogate_model(as.vector(search_state$poly_recs[1,]),search_state$polyouts,search_state$centersaves,deg=1)
  if (mean(abs((modout-surrogate_out)/modout))>10){
    genstate = T
  }else{
    genstate = F
  }
  par(oma=c(0, 0, 0, 5))
  matplot(xdat,search_state$current_pout,type="l",col="grey",xlab = NULL,ylab="value",ylim = c(0,1.2))
  points(xdat,ydat)
  lines(xdat,surrogate_out,col="blue")
  lines(xdat,model_function(as.vector(search_state$poly_recs[1,])),col="red")
  title("Surrogate Search Optimization")
  legend(par('usr')[2], par('usr')[4], bty='n', xpd=NA,c("Observed","Modeled","Predicted","Actual"),fill=c("black","grey","blue","red"))
}

print(paste("Number of function evals: ",dim(search_state$xpins)[1]))
#> [1] "Number of function evals:  847"

Search-Initialized Scedastic Surrogate Swarm Optimization

We can then convert these search states and the learned surrogates into the initialization of a Scedastic Surrogate Swarm

usevec = c(sample(1:dim(search_state$xpins)[1],ls*2),dim(search_state$xpins)[1])
#usevec = (dim(search_state$xpins)[1]-ls*2):dim(search_state$xpins)[1]

#Swap into particle swarm
swarm_state <- convert_search_to_swarm(search_state = search_state,usevec = usevec,desired_values = ydat,param_len = ls*3,lowlim=lowlim,highlim=highlim,ineq_w = c(),eq_w=c(),config = swarm.config(swarm_size=length(usevec),num_cluster=1,deg=1))

for (itt in 1:20){
  tempcontrol = swarm.control(poly_w=0.2,stoch_w = 0.01)
  swarm_state <- step_swarm(desired_values = ydat,swarm_state,ineq_w = c(),eq_w=c(),config = swarm.config(swarm_size=length(usevec),num_cluster=1,swarm.control = tempcontrol))
  par(oma=c(0, 0, 0, 5))
  matplot(xdat,swarm_state$pout,type="l",col="grey",xlab = NULL,ylab="value",ylim = c(0,1.2))
  points(xdat,ydat)
  surrogate_out <- surrogate_model(as.vector(swarm_state$poly_rec),swarm_state$polyouts,swarm_state$centersaves,deg=1)
  lines(xdat,surrogate_out,col="blue")
  lines(xdat,model_function(as.vector(swarm_state$poly_rec),ls),col="red")
  title("Search-Initialized Scedastic Surrogate Swarm Optimization")
  legend(par('usr')[2], par('usr')[4], bty='n',
         xpd=NA,c("Observed","Modeled","Predicted","Actual"),fill=c("black","grey","blue","red"))
}

print(paste("Number of function evals: ",dim(swarm_state$allxp)[1]))
#> [1] "Number of function evals:  1667"